home *** CD-ROM | disk | FTP | other *** search
/ Suzy B Software 2 / Suzy B Software CD-ROM 2 (1994).iso / adult_ed / grapher / graph3d / 3dgraph.pas next >
Pascal/Delphi Source File  |  1995-05-02  |  80KB  |  2,304 lines
  1. program threeD(input,output);
  2.  
  3. const
  4.  
  5.   minint = -32767;
  6.   pi = 3.14159;
  7.  
  8. {$I GEMCONST.PAS}
  9.  
  10. type
  11.   Menu_Option_Type = (Colors,Grid,G_Function,View,Draw,Help,Quit);
  12.   Res_Type = (Low, Med, Hi);
  13.   TokenType = (Numeric, Character);
  14.   NodePtr = ^Node;
  15.   Node = Record
  16.     Link: NodePtr;
  17.     case NodeType: TokenType of
  18.       Numeric: (Value: real);
  19.       Character: (Code: char;
  20.                   Priority: 0..5)
  21.   end;
  22.   Intensity_Type = array [0..2,1..3] of 0..8;
  23.  
  24. {$I GEMTYPE.PAS}
  25.  
  26. var
  27.   sx,sy: array [-32..32,-32..32] of integer;  { Screen coordinates }
  28.   lx,ly,lz: array [-32..32,-32..32] of real;  { Logical coordinates }
  29.   Res: Res_Type;                  { Resolution }
  30.   X_Center, Y_Center: integer;    { Center of screen }
  31.   SF,           { Compensates for aspect ratio }
  32.   Max_Z,        { Maximum Z value allowed }
  33.   Min_Z,        { Minimum Z value allowed }
  34.   x,y,          { x and y coordinates }
  35.   d,            { distance from point to origin }
  36.   r: real;      { square of distance from point to origin }
  37.   max, min: array [-640..1280] of integer;  { Holds max and min y values }
  38.                                             { for each possible x value. }
  39.  
  40.   Option: Menu_Option_Type;       { Choice from main menu }
  41.  
  42.   Intensity: Intensity_Type;      { Values for color registers }
  43.  
  44.   XLim, YLim: integer;            { Number of grid lines on x, y axes }
  45.   Grid_Scale: real;               { Scale per grid line }
  46.  
  47.   InFix: Str255;                  { The function being graphed }
  48.   PostFix: NodePtr;               { Pointer to postfix version of function }
  49.   Syntax_Error: boolean;
  50.  
  51.   Azimuth,                        { Position around z-axis }
  52.   Altitude,                       { Elevation above or below x-y plane }
  53.   Screen_Scale: integer;          { Size of displayed graph }
  54.   Plot_Fast,                      { TRUE if fast plotting desired }
  55.   Perspective,                    { TRUE if perspective desired }
  56.   Draw_Both_Ways,                 { TRUE if boths sets of grids desired }
  57.   Hidden_Lines,                   { TRUE if hidden lines are desired }
  58.   Draw_Top,                       { TRUE if top of graph should be drawn }
  59.   Draw_Bottom: boolean;            { TRUE if bottom should be drawn }
  60.  
  61.   Must_Load1,               { TRUE if no coordinates have been calculated }
  62.   Must_Load2,               { TRUE if coordinates must be recalculated }
  63.   Must_Transform: boolean;  { TRUE if points must be transformed }
  64.  
  65.   { The following variables are used to get events in menu screens }
  66.  
  67.   Done: boolean;        { TRUE if user clicks on OK button }
  68.   Event: integer;
  69.   Dummy_Buffer: Message_Buffer;
  70.   Dummy: integer;       { Dummy parameters to Get_Event}
  71.   mx, my: integer;      { Coordinates of mouse }
  72.  
  73. {$I GEMSUBS.PAS}
  74.  
  75. {**************************  GotoXY  *********************************
  76. *                                                                    *
  77. *  Used to provide cursor control when printing to the screen.       *
  78. *                                                                    *
  79. *  Called by: Various user input modules                             *
  80. *                                                                    *
  81. *  In parameters: x, y screen positions                              *
  82. *                                                                    *
  83. *********************************************************************}
  84.  
  85. procedure GotoXY(x,y: integer);
  86.  
  87.   procedure bconout(device, c: integer);
  88.     BIOS(3);
  89.  
  90. begin
  91.   bconout(2,27);
  92.   bconout(2,ord('Y'));
  93.   bconout(2,31+x);
  94.   bconout(2,31+y)
  95. end; {GotoXY}
  96.  
  97. {**************************  Initialization  **************************
  98. *                                                                     *
  99. *  Initializes global variables.                                      *
  100. *                                                                     *
  101. *  Called by: MAIN DRIVER                                             *
  102. *                                                                     *
  103. **********************************************************************}
  104.  
  105. procedure Initialization;
  106.  
  107. var
  108.   I,                         { Loop counter }
  109.   Scr_Res: integer;          { 0, 1, or 2 for screen resolution }
  110.   r: 1..2;                   { 1 if color monitor is used, 2 otherwise }
  111.  
  112.   function Get_Res : Integer;
  113.     XBIOS(4);
  114.  
  115. begin
  116.  
  117.   { Determine screen environment }
  118.  
  119.   Scr_Res := Get_Res;
  120.   case Scr_Res of
  121.  
  122.     0 : begin
  123.           Res := Low;
  124.           X_Center := 160;
  125.           Y_Center := 100;
  126.           Set_Clip(0,0,320,200);
  127.           SF := 0.869
  128.         end; {0}
  129.  
  130.     1 : begin
  131.           Res := Med;
  132.           X_Center := 320;
  133.           Y_Center := 100;
  134.           Set_Clip(0,0,640,200);
  135.           SF := 0.434
  136.         end; {1}
  137.  
  138.     2 : begin
  139.           Res := Hi;
  140.           X_Center := 320;
  141.           Y_Center := 200;
  142.           Set_Clip(0,0,640,400);
  143.           SF := 0.869
  144.         end; {2}
  145.  
  146.   end; {case}
  147.  
  148.   if Res = Hi then
  149.     r := 2
  150.   else
  151.     r := 1;
  152.  
  153.   { Print Copyright message }
  154.   Clear_Screen;
  155.   GotoXY(1,1);
  156.   writeln('        3-D Grapher');
  157.   writeln('      by Delmar Searls');
  158.   writeln;
  159.   writeln(' (Parts of this product are');
  160.   writeln('Copyright (c) 1986, OSS & CCD');
  161.   writeln('  Used by persmission of OSS)');
  162.   Text_Style(Thickened);
  163.   Draw_String(112,104*r,'OK');
  164.   Text_Style(Normal);
  165.   Frame_Rect(88,81*r,64,40*r);
  166.  
  167.   { Wait for user to click on OK button }
  168.   Done := FALSE;
  169.   Set_Mouse(M_Arrow);
  170.   repeat
  171.     Show_Mouse;
  172.     Event := Get_Event(E_Button,1,1,1,0,FALSE,0,0,0,0,FALSE,0,0,0,0,
  173.                        Dummy_Buffer,Dummy,Dummy,Dummy,mx,my,Dummy);
  174.     Hide_Mouse;
  175.     if Res = Hi then
  176.       my := my DIV 2;
  177.     if Event = E_Button then
  178.       if (mx>88) AND (mx<154) AND (my>81) AND (my<121) then
  179.         Done := TRUE
  180.   until Done;
  181.  
  182.   { Set up general environment }
  183.   Text_Color(1);
  184.   Line_Color(1);
  185.   Draw_Mode(1);
  186.  
  187.   { Set up initial intensities for colors 0, 1, & 2 }
  188.   for I := 1 to 3 do begin
  189.     Intensity[0,I] := 7;
  190.     Intensity[1,I] := 0;
  191.     Intensity[2,I] := 0
  192.   end; {for}
  193.   Intensity[2,1] := 7;
  194.  
  195.   { Set up initial view parameters }
  196.   Azimuth := 30;
  197.   Altitude := 10;
  198.   Screen_Scale := 100;
  199.   Plot_Fast := TRUE;
  200.   Perspective := TRUE;
  201.   Draw_Both_Ways := TRUE;
  202.   Hidden_Lines := TRUE;
  203.   Draw_Top := TRUE;
  204.   Draw_Bottom := TRUE;
  205.  
  206.   { Set up initial Grid parameters }
  207.   Grid_Scale := 0.25;
  208.   XLim := 16;
  209.   YLim := 16;
  210.  
  211.   { Set up some odds and ends }
  212.   InFix := '-3*EXP(-R/8)*(SIN(R/2)-COS(R/3))-1';
  213.   Syntax_Error := FALSE;
  214.   Must_Load1 := TRUE;
  215.   Must_Transform := TRUE
  216. end; {Initialization}
  217.  
  218.  
  219. {**************************  Menu_Option  ****************************
  220. *                                                                    *
  221. *  Display the main menu and allow the user to select an option.     *
  222. *                                                                    *
  223. *  Called by: MAIN DRIVER                                            *
  224. *                                                                    *
  225. *********************************************************************}
  226.  
  227. function Menu_Option: Menu_Option_Type;
  228.  
  229. var
  230.   Dialog: Dialog_Ptr;
  231.   Button: array [1..7] of integer;
  232.   Button_Text: string[8];
  233.   I,               { Loop counter }
  234.   Choice,          { Indicates which button user selected }
  235.   Row: integer;    { Text row in dialog box }
  236.  
  237. begin
  238.   Clear_Screen;
  239.  
  240.   { Set up the menu dialog box }
  241.  
  242.   Dialog := New_Dialog(7,0,0,16,15);
  243.   for I := 1 to 7 do begin
  244.     Row := 2*I-1;
  245.     if (I = 1) AND (Res = Hi) then
  246.       Button[I] := Add_DItem(Dialog,G_Button,None,4,Row,8,1,0,0)
  247.     else
  248.       Button[I]:= Add_DItem(Dialog,G_Button,Selectable|Exit_Btn,4,Row,8,1,0,0);
  249.     case I of
  250.       1: Button_Text := 'Color';
  251.       2: Button_Text := 'Grid';
  252.       3: Button_Text := 'Function';
  253.       4: Button_Text := 'View';
  254.       5: Button_Text := 'Draw';
  255.       6: Button_Text := 'Help';
  256.       7: Button_Text := 'Quit'
  257.     end; {case}
  258.     if (I = 1) AND (Res = Hi) then
  259.       Set_DText(Dialog, Button[I], Button_Text,5,TE_Center)
  260.     else
  261.       Set_DText(Dialog, Button[I], Button_Text,3,TE_Center)
  262.   end; {for}
  263.  
  264.   { Display menu and get user's choice }
  265.  
  266.   Center_Dialog(Dialog);
  267.   Set_Mouse(M_Point_Hand);
  268.   Show_Mouse;
  269.   Choice := Do_Dialog(Dialog,0);
  270.   End_Dialog(Dialog);
  271.   Hide_Mouse;
  272.   Delete_Dialog(Dialog);
  273.  
  274.   { Analyze user's choice }
  275.  
  276.   if Choice = Button[1] then Menu_Option := Colors
  277.   else if Choice = Button[2] then Menu_Option := Grid
  278.   else if Choice = Button[3] then Menu_Option := G_Function
  279.   else if Choice = Button[4] then Menu_Option := View
  280.   else if Choice = Button[5] then Menu_Option := Draw
  281.   else if Choice = Button[6] then Menu_Option := Help
  282.   else Menu_Option := Quit;
  283.  
  284. end; {Menu_Option}
  285.  
  286. {**************************  Get_Colors  *****************************
  287. *                                                                    *
  288. *  Allow the user to determine the color of the background, the      *
  289. *  top of the graph, and the bottom of the graph.                    *
  290. *                                                                    *
  291. *  Called by: MAIN DRIVER                                            *
  292. *                                                                    *
  293. *  In/Out parameters: Intensity levels                               *
  294. *                                                                    *
  295. *********************************************************************}
  296.  
  297. procedure Get_Colors(var Intensity: Intensity_Type);
  298.  
  299. var
  300.   IString,              { Holds string representation of intensity level }
  301.   Up_Arrows,
  302.   Down_Arrows: str255;
  303.   Key,                  { Stores value of key pressed by user }
  304.   K,                    { 0 => raise intensity, 1 => lower intensity }
  305.   I, J: integer;        { Row and Column counters }
  306.   T,                    { Holds parameters to Set_Color procedure }
  307.   XPos: array [1..3] of integer;  { Store print positions }
  308.   YPos: array [0..3] of integer;  { Store print positions }
  309.  
  310. begin
  311.   { Load graph colors into color registers }
  312.   for I := 0 to 1 do begin
  313.     for J := 1 to 3 do
  314.       T[J] := 60 + 125*Intensity[I,J];
  315.     Set_Color(I,T[1],T[2],T[3])
  316.   end; {for}
  317.  
  318.   Clear_Screen;
  319.   Set_Mouse(M_Arrow);
  320.  
  321.   { Set positions of arrows }
  322.   XPos[1] := 161;
  323.   XPos[2] := 177;
  324.   XPos[3] := 193;
  325.   YPos[0] := 48;
  326.   YPos[1] := 104;
  327.   YPos[2] := 160;
  328.  
  329.   { Create a string of 3 up arrows }
  330.   Up_Arrows := '     ';
  331.   Up_Arrows[1] := chr(1);
  332.   Up_Arrows[3] := chr(1);
  333.   Up_Arrows[5] := chr(1);
  334.  
  335.   { Create a string of 3 down arrows }
  336.   Down_Arrows := '     ';
  337.   Down_Arrows[1] := chr(2);
  338.   Down_Arrows[3] := chr(2);
  339.   Down_Arrows[5] := chr(2);
  340.  
  341.   { Create screen display }
  342.   Draw_String(64,8, 'Adjust Color Registers');
  343.   Draw_String(161,32, Up_Arrows);
  344.   Draw_String(0,48, 'Background');
  345.   Draw_String(161,64, Down_Arrows);
  346.   Draw_String(161,88, Up_Arrows);
  347.   Draw_String(57,104,'Top');
  348.   Draw_String(161,120, Down_Arrows);
  349.   Draw_String(161,144, Up_Arrows);
  350.   Draw_String(33,160,'Bottom');
  351.   Draw_String(161,176, Down_Arrows);
  352.   Paint_Color(1);
  353.   Paint_Rect(97,89,48,24);
  354.   Paint_Color(2);
  355.   Paint_Rect(97,145,48,24);
  356.   Frame_Rect(241,81,64,40);
  357.   Text_Style(Thickened);
  358.   Draw_String(265,104, 'OK');
  359.   Text_Style(Normal);
  360.  
  361.   { Display current graph color register values }
  362.   IString := ' ';
  363.   for I := 0 to 2 do
  364.     for J := 1 to 3 do begin
  365.       IString[1] := chr(ord('0')+Intensity[I,J]);
  366.       Draw_String(XPos[J], YPos[I], IString)
  367.     end; {for}
  368.  
  369.   { Check for and process user changes }
  370.   Done := FALSE;
  371.   repeat
  372.     Show_Mouse;
  373.     Event := Get_Event(E_Keyboard|E_Button,1,1,1,0,
  374.                        FALSE,0,0,0,0,FALSE,0,0,0,0,
  375.                        Dummy_Buffer,Key,Dummy,Dummy,mx,my,Dummy);
  376.     Hide_Mouse;
  377.  
  378.     if (Event = E_keyboard) AND (Key = 283) then begin {Escape key pressed}
  379.         Set_Color(0,1000,1000,1000);
  380.         Set_Color(1,0,0,0);
  381.         for J := 1 to 3 do begin
  382.           Intensity[0,J] := 7;
  383.           Intensity[1,J] := 0
  384.         end; {for}
  385.         Done := TRUE
  386.     end; {if}
  387.  
  388.     if Event = E_Button then
  389.       if (mx>241) AND (mx<305) AND (my>81) AND (my<121) then
  390.         Done := TRUE
  391.       else begin
  392.         I := -1;
  393.         J := 0;
  394.  
  395.         if (mx>158) AND (mx<171) then
  396.           J := 1  {Red}
  397.         else if (mx>174) AND (mx<187) then
  398.           J := 2  {Green}
  399.         else if (mx>190) AND (mx<203) then
  400.           J := 3; {Blue}
  401.  
  402.         if (my>24) AND (my<33) then
  403.           I := 0  { Increase background register value }
  404.         else if (my>56) AND (my<65) then
  405.           I := 1  { Decrease background register value }
  406.         else if (my>80) AND (my<89) then
  407.           I := 2  { Increase top color register value }
  408.         else if (my>112) AND (my<121) then
  409.           I := 3  { Decrease top color register value }
  410.         else if (my>136) AND (my<145) then
  411.           I := 4  { Increase bottom color register value }
  412.         else if (my>168) AND (my<177) then
  413.           I := 5; { Decrease bottom color register value }
  414.  
  415.         { Adjust color register if necessary }
  416.         if (I>-1) AND (J>0) then begin
  417.           K := I MOD 2;
  418.           I := I DIV 2;
  419.  
  420.           if K = 0 then
  421.             Intensity[I,J] := (Intensity[I,J] + 1) MOD 8
  422.           else
  423.             Intensity[I,J] := (Intensity[I,J] + 7) MOD 8;
  424.  
  425.           IString[1] := chr(ord('0') + Intensity[I,J]);
  426.           Draw_String(XPos[J], YPos[I], IString);
  427.  
  428.           for J := 1 to 3 do
  429.             T[J] := 60 + 125*Intensity[I,J];
  430.           Set_Color(I, T[1], T[2], T[3]);
  431.           if I > 0 then begin
  432.             Paint_Color(I);
  433.             Paint_Rect(97,33+I*56,48,24)
  434.           end {if}
  435.  
  436.         end {if}
  437.       end {else}
  438.   Until Done;
  439.   Set_Color(0,1000,1000,1000);
  440.   Set_Color(1,0,0,0)
  441. end; {Get_Colors}
  442.  
  443. {**********************  Get_Grid_Parameters  ************************
  444. *                                                                    *
  445. *  Get the number of grid lines and scale per grid line.             *
  446. *                                                                    *
  447. *  Called by: MAIN DRIVER                                            *
  448. *                                                                    *
  449. *  Out parameters: Grid_Scale, XLim, YLim                            *
  450. *                                                                    *
  451. *********************************************************************}
  452.  
  453. procedure Get_Grid_Parameters(var Grid_Scale: real;
  454.                               var XLim, YLim: integer;
  455.                               var Must_Load2: boolean);
  456.  
  457. var
  458.   TStr: Str255;        { Temporary storage used in Draw_String }
  459.  
  460.   TempXLim,
  461.   TempYLim: integer;   { Temporary storage in case of an Abort }
  462.   TempScale: real;
  463.  
  464.   r: 1..2;             {1 if color monitor used, 2 otherwise}
  465.  
  466. begin
  467.   TempXLim := XLim;
  468.   TempYLim := YLim;
  469.   TempScale := Grid_Scale;
  470.  
  471.   if Res = Hi then
  472.     r := 2
  473.   else
  474.     r := 1;
  475.  
  476.   Clear_Screen;
  477.   Set_Mouse(M_Arrow);
  478.  
  479.   { Draw Arrows }
  480.   TStr := ' ';
  481.   Tstr[1] := chr(4);
  482.   Draw_String(55,46*r,TStr);
  483.   Draw_String(55,118*r,TStr);
  484.   Draw_String(55,158*r,TStr);
  485.   Tstr[1] := chr(3);
  486.   Draw_String(129,46*r,TStr);
  487.   Draw_String(129,118*r,TStr);
  488.   Draw_String(129,158*r,TStr);
  489.  
  490.   { Display Text }
  491.   GotoXY(3,8); write('Grid Scale');
  492.   GotoXY(4,5); write('(per grid line)');
  493.   GotoXY(6,11); write(Grid_Scale:4:2);
  494.   GotoXY(10,3); write('Number of Grid Lines');
  495.   GotoXY(11,5); write('(positive axis)');
  496.   GotoXY(13,10); write('X-Axis');
  497.   GotoXY(15,12); write(XLim:2);
  498.   GotoXY(18,10); write('Y-Axis');
  499.   GotoXY(20,12); write(YLim:2);
  500.   Draw_String(253,66*r,'ABORT');
  501.   Text_Style(Thickened);
  502.   Draw_String(265,104*r, 'OK');
  503.   Text_Style(Normal);
  504.  
  505.   { Draw Boxes }
  506.   Frame_Rect(68,36*r,56,16*r);
  507.   Frame_Rect(68,108*r,56,16*r);
  508.   Frame_Rect(68,148*r,56,16*r);
  509.   Frame_Rect(241,55*r,64,16*r);
  510.   Frame_Rect(241,81*r,64,40*r);
  511.  
  512.   Must_Load2 := FALSE;
  513.   Done := FALSE;
  514.   repeat
  515.     Show_Mouse;
  516.     Event := Get_Event(E_Button,1,1,1,0,
  517.                        FALSE,0,0,0,0,FALSE,0,0,0,0,
  518.                        Dummy_Buffer,Dummy,Dummy,Dummy,mx,my,Dummy);
  519.     Hide_Mouse;
  520.     if Res = Hi then
  521.       my := my DIV 2;
  522.     if Event = E_Button then
  523.       if (mx>241) AND (mx<305) then begin
  524.         if (my>81) AND (my<121) then
  525.           Done := TRUE
  526.         else if (my>55) AND (my<71) then begin
  527.           { Restore orginal values and abort }
  528.           Must_Load2 := FALSE;
  529.           XLim := TempXLim;
  530.           YLim := TempYLim;
  531.           Grid_Scale := TempScale;
  532.           Done := TRUE
  533.         end {else if}
  534.       end {else if}
  535.       else if (my>38) AND (my<49) then begin
  536.         if (mx>54) AND (mx<65) AND (Grid_Scale > 0.06) then begin
  537.           Grid_Scale := Grid_Scale-0.05;
  538.           Must_Load2 := TRUE
  539.         end {if}
  540.         else if (mx>128) AND (mx<139) AND (Grid_Scale < 3.96) then begin
  541.           Grid_Scale := Grid_Scale+0.05;
  542.           Must_Load2 := TRUE
  543.         end; {else if}
  544.         GotoXY(6,11); write(Grid_Scale:4:2)
  545.       end {else if}
  546.       else if (my>110) AND (my<121) then begin
  547.         if (mx>54) AND (mx<65) AND (XLim>4) then begin
  548.           XLim := XLim - 4;
  549.           Must_Load2 := TRUE
  550.         end {if}
  551.         else if (mx>128) AND (mx<139) AND (XLim<32) then begin
  552.           XLim := XLim + 4;
  553.           Must_Load2 := TRUE
  554.         end; {if else}
  555.         GotoXY(15,12); write(XLim:2)
  556.       end {else if}
  557.       else if (my>150) AND (my<161) then begin
  558.         if (mx>54) AND (mx<65) AND (YLim>4) then begin
  559.           YLim := YLim - 4;
  560.           Must_Load2 := TRUE
  561.         end {if}
  562.         else if (mx>128) AND (mx<139) AND (YLim<32) then begin
  563.           YLim := YLim + 4;
  564.           Must_Load2 := TRUE
  565.         end; {else if}
  566.         GotoXY(20,12); write(YLim:2)
  567.       end {else if}
  568.   until Done
  569. end; {Get_Grid_Parameters}
  570.  
  571. {**************  Convert  ********************************************
  572. *                                                                    *
  573. *  This function converts the input expression from infix to         *
  574. *  postfix notation.  A pointer to the postfix expression is         *
  575. *  is returned as the as the value of Convert.                       *
  576. *                                                                    *
  577. *  Called by: Get_Function                                           *
  578. *                                                                    *
  579. *  In parameter: The infix expression                                *
  580. *  Out parameter: Syntax error flag                                  *
  581. *********************************************************************}
  582.  
  583. function Convert(InString {in}: Str255;
  584.                  var Syntax_Error {out}: boolean): NodePtr;
  585.  
  586. var
  587.   TempStr: Str255; {Temporary storage of Infix expression}
  588.   PostFix,         {Pointer to the postfix expression}
  589.   Tail,            {Pointer to last token in postfix expression}
  590.   Token,           {A token to be added to postfix expression}
  591.   TOS: NodePtr;    {Pointer to top of stack used in conversion}
  592.   I,               {Loop counter}
  593.   L: integer;      {Length of InFix expression}
  594.   Previous_Token: char;  {Denotes the type of the previous token.  This
  595.                           has a value of '(' for right parenthesis, and
  596.                           a 'N' if previous token was numeric.  Numeric
  597.                           tokens are numbers, 'X', and ')'.  A code of
  598.                           'F' indicates a function token.  Otherwise
  599.                           this identifier is assigned the null character. }
  600.  
  601.   {------------  Next_Token  -------------------
  602.   |                                             |
  603.   |  This function removes the next item from   |
  604.   |  the infix expression and returns the       |
  605.   |  corresponding token.                       |
  606.   |                                             |
  607.   |  Called by: Convert                         |
  608.   |                                             |
  609.   |  In/Out parameter: The infix expression     |
  610.   |                    Previous token           |
  611.   |  Out parameter: Syntax error flag           |
  612.    ---------------------------------------------}
  613.  
  614.   function Next_Token(var InFix {in/out}: Str255;
  615.                       var Previous_Token: char;
  616.                       var Syntax_Error {out}: boolean): NodePtr;
  617.  
  618.   var
  619.     Token: NodePtr;   {The new token}
  620.     TStr: Str255;     {Stores numeric operand in string form}
  621.     TChar: char;      {Token code for non-numeric tokens}
  622.     T: integer;       {Temporary storage for token priority}
  623.  
  624.       {- - - - - - - - - Str_to_Num - - - - - - - - - -
  625.       -                                               -
  626.       -  Converts a string representation of a number -
  627.       -  to the numeric representation.               -
  628.       -                                               -
  629.       -  Called by: Next_Token                        -
  630.       -                                               -
  631.       -  In parameter: The string representation      -
  632.       -  Out parameter: Syntax error flag             -
  633.        - - - - - - - - - - - - - - - - - - - - - - - -}
  634.  
  635.       function Str_to_Num(NumStr {in}: Str255;
  636.                           var Syntax_Error {out}: boolean): Real;
  637.  
  638.       var
  639.         Integer_Part,          {Integer part of number}
  640.         Fraction_Part,         {Fraction part of number}
  641.         Power_of_Ten: real;    {Used in finding fraction part}
  642.         DP,                    {Position of decimal point}
  643.         Num_Int_Digits,        {Number of digits in integer part}
  644.         Num_Frac_Digits,       {Number of digits in fractional part}
  645.         I: integer;            {Loop counter}
  646.  
  647.       begin
  648.  
  649.         { Initialize variables. }
  650.  
  651.         Integer_Part := 0;
  652.         Fraction_Part := 0;
  653.         Power_of_Ten := 1;
  654.  
  655.         { Determine number of digits in integer part and fraction part. }
  656.  
  657.         DP := pos('.', NumStr);
  658.         if DP = 0 then begin  { string represents an integer }
  659.           Num_Int_Digits := length(NumStr);
  660.           Num_Frac_Digits := 0
  661.         end {if}
  662.         else begin  { string represents a real }
  663.           Num_Int_Digits := DP-1;
  664.           Num_Frac_Digits := length(NumStr)-DP
  665.         end; {else}
  666.  
  667.         {  Convert integer part to numeric form. }
  668.  
  669.         for I := 1 to Num_Int_Digits do begin
  670.           Integer_Part := 10*Integer_Part + ord(NumStr[1]) - ord('0');
  671.           delete(NumStr,1,1)
  672.         end; {for}
  673.  
  674.         if NumStr <> '' then  { delete decimal point from string }
  675.           delete(NumStr,1,1);
  676.  
  677.         {  Convert fraction part (if any) to numeric form. }
  678.  
  679.         if Num_Frac_Digits > 0 then  { first check for extra decimal point }
  680.           if pos('.', NumStr) = 0 then begin  { conversion process }
  681.             for I := 1 to Num_Frac_Digits do begin
  682.               Fraction_Part := 10*Fraction_Part + ord(NumStr[1]) - ord('0');
  683.               Power_of_Ten := 10*Power_of_Ten;
  684.               delete(NumStr,1,1)
  685.             end; {for}
  686.             Fraction_Part := Fraction_Part/Power_of_Ten
  687.           end {if}
  688.           else
  689.             Syntax_Error := TRUE;
  690.  
  691.         Str_to_Num := Integer_Part + Fraction_Part
  692.       end; {Str_to_Num}
  693.       {- - - - - - - - - - - - - - - - - - - - - - - -}
  694.  
  695.   begin { Next_Token }
  696.  
  697.     { Get and initialize token node. }
  698.  
  699.     new(Token);
  700.     Token^.Link := NIL;
  701.  
  702.     while InFix[1] = ' ' do  { remove leading blanks }
  703.       delete(InFix,1,1);
  704.  
  705.     TStr := InFix[1];  { Transfer first character of infix to TStr. }
  706.     delete(InFix,1,1);
  707.  
  708.     if TStr[1] in ['0'..'9','.'] then begin  { Token is a number. }
  709.       Token^.NodeType := Numeric;
  710.  
  711.       { Read the number as a string of valid numeric characters. }
  712.  
  713.       while (InFix <> '') and (InFix[1] in ['.','0'..'9']) do begin
  714.         TStr := concat(TStr, InFix[1]);
  715.         delete(InFix,1,1)
  716.       end; {while}
  717.  
  718.       { Convert string representation to numeric. }
  719.  
  720.       Token^.Value := Str_to_Num(TStr, Syntax_Error);
  721.  
  722.       { Do a little error checking.  A number cannot directly follow
  723.         another numeric token or a function token. }
  724.  
  725.       if NOT Syntax_Error then
  726.         if (Previous_Token = 'N') OR (Previous_Token = 'F') then
  727.           Syntax_Error := TRUE
  728.         else  {reset previous token code}
  729.            Previous_Token := 'N'
  730.     end {if}
  731.     else begin  { Token is character type token. }
  732.       Token^.NodeType := Character;
  733.       TChar := TStr[1];
  734.       Token^.Code := TChar;
  735.  
  736.       { Determine priority of token }
  737.  
  738.       case TChar of
  739.         'X','Y','R','D','(',')': Token^.Priority := 0;
  740.                 '+': Token^.Priority := 1;
  741.                 '-': if Previous_Token = '(' then begin
  742.                        Token^.Priority := 3;
  743.                        TChar := '~';
  744.                        Token^.Code := '~'
  745.                      end {if}
  746.                      else
  747.                        Token^.Priority := 1;
  748.             '*','/': Token^.Priority := 2;
  749.                 '^': Token^.Priority := 4;
  750.  
  751.                 { Also check for syntax errors in function tokens. }
  752.  
  753.                 'A': if (Length(InFix) > 1) and (InFix[1] = 'B')
  754.                                               and (InFix[2] = 'S') then begin
  755.                        Token^.Priority := 5;
  756.                        delete(InFix,1,2)
  757.                      end {if}
  758.                      else
  759.                        Syntax_Error := TRUE;
  760.                 'C': if (Length(InFix) > 1) and (InFix[1] = 'O')
  761.                                               and (InFix[2] = 'S') then begin
  762.                        Token^.Priority := 5;
  763.                        delete(InFix,1,2)
  764.                      end {if}
  765.                      else
  766.                        Syntax_Error := TRUE;
  767.                 'E': if (Length(InFix) > 1) and (InFix[1] = 'X')
  768.                                               and (InFix[2] = 'P') then begin
  769.                        Token^.Priority := 5;
  770.                        delete(InFix,1,2)
  771.                      end {if}
  772.                      else
  773.                        Syntax_Error := TRUE;
  774.                 'L': if (Length(InFix) > 0) and (InFix[1] = 'N') then begin
  775.                        Token^.Priority := 5;
  776.                        delete(InFix,1,1)
  777.                      end {if}
  778.                      else
  779.                        Syntax_Error := TRUE;
  780.                 'S': if (Length(InFix) > 1) and (InFix[1] = 'I')
  781.                                               and (InFix[2] = 'N') then begin
  782.                        Token^.Priority := 5;
  783.                        delete(InFix,1,2)
  784.                      end {if}
  785.                      else if (Length(Infix)>1) and (Infix[1] = 'Q')
  786.                                                and (Infix[2] = 'R') then begin
  787.                        Token^.Priority := 5;
  788.                        Token^.Code := 'Q';
  789.                        delete(InFix,1,2)
  790.                      end {else if}
  791.                      else
  792.                        Syntax_Error := TRUE;
  793.                 'T': if (Length(Infix) > 1) and (InFix[1] = 'A')
  794.                                               and (InFix[2] = 'N') then begin
  795.                        Token^.Priority := 5;
  796.                        delete(InFix,1,2)
  797.                      end {if}
  798.                      else
  799.                        Syntax_Error := TRUE;
  800.           OTHERWISE: Syntax_Error := TRUE  { Since token was not in list }
  801.       end; {case}
  802.  
  803.       if NOT Syntax_Error then begin
  804.  
  805.         { Do a little error checking. }
  806.  
  807.         T := Token^.Priority;
  808.         if ((T = 5) OR (TChar in ['X','Y','R','D','(']))
  809.                  AND (Previous_Token = 'N') then
  810.           Syntax_Error := TRUE
  811.         else if ((T = 5) OR (TChar in ['X','Y','R','D']))
  812.                  AND (Previous_Token = 'F') then
  813.           Syntax_Error := TRUE
  814.         else if ((T = 1) OR (T = 2) OR (T = 4) OR (TChar = ')'))
  815.                  AND (Previous_Token <> 'N') then
  816.           Syntax_Error := TRUE;
  817.  
  818.         { Reset previous token code. }
  819.  
  820.         if NOT Syntax_Error then
  821.           if Token^.Nodetype = Numeric then
  822.             Previous_Token := 'N'
  823.           else if TChar in ['X','Y','R','D',')'] then
  824.             Previous_Token := 'N'
  825.           else if TChar = '(' then
  826.             Previous_Token := '('
  827.           else if T = 5 then
  828.             Previous_Token := 'F'
  829.           else
  830.             Previous_Token := chr(0)
  831.       end {if}
  832.     end; {else}
  833.     Next_Token := Token
  834.   end; {Next_Token}
  835.  
  836.   {------------------  Append  -----------------
  837.   |                                             |
  838.   |  This procedure appends the input token to  |
  839.   |  the postfix expression.                    |
  840.   |                                             |
  841.   |  Called by: Convert                         |
  842.   |                                             |
  843.   |  In parameter: The token                    |
  844.   |  In/Out parameter: Pointer to last token    |
  845.   |                    in postfix expression    |
  846.    ---------------------------------------------}
  847.  
  848.   procedure Append(var Tail {in/out}: NodePtr;
  849.                        Item {in}: NodePtr);
  850.  
  851.   var Temp: NodePtr;
  852.  
  853.   begin
  854.     if Item^.Link <> NIL then  {Item is on stack, append copy to postfix. }
  855.       new(Temp)
  856.     else  { The item itself is appended to postfix. }
  857.       Temp := Item;
  858.     Temp^ := Item^;
  859.     Tail^.Link := Temp;
  860.     Tail := Temp;
  861.     Temp^.Link := NIL
  862.   end; {Append}
  863.  
  864.   {-----------------  Push  --------------------
  865.   |                                             |
  866.   |  Push a token onto the stack                |
  867.   |                                             |
  868.   |  Called by: Convert                         |
  869.   |                                             |
  870.   |  In parameter: The token                    |
  871.   |  In/Out parameter: The top of stack ptr     |
  872.    ---------------------------------------------}
  873.  
  874.   procedure Push(var TOS {in/out}: NodePtr;
  875.                      Item {in}: NodePtr);
  876.  
  877.   begin
  878.     Item^.Link := TOS;
  879.     TOS := Item
  880.   end;
  881.  
  882.   {-------------------  Pop --------------------
  883.   |                                             |
  884.   |  Delete the top element from the stack.     |
  885.   |                                             |
  886.   |  Called by: Convert                         |
  887.   |                                             |
  888.   |  In/Out parameter: The top of stack ptr     |
  889.    ---------------------------------------------}
  890.  
  891.   procedure Pop(var TOS {in/out}: NodePtr);
  892.  
  893.   var
  894.     Temp: NodePtr;
  895.  
  896.   begin
  897.     Temp := TOS;
  898.     TOS := TOS^.Link;
  899.     dispose(Temp)
  900.   end; {Pop}
  901.  
  902. {********    Convert code starts here    *******}
  903.  
  904. begin
  905.   TempStr := InString;
  906.   Syntax_Error := FALSE;
  907.   Previous_Token := '(';
  908.  
  909.   { Create 'NULL' node on stack. }
  910.  
  911.   new(TOS);
  912.   TOS^.NodeType := Character;
  913.   TOS^.Priority := 0;
  914.   TOS^.Code := '@';
  915.   TOS^.Link := NIL;
  916.  
  917.   {Create a dummy head node. }
  918.  
  919.   new(PostFix);
  920.   Tail := PostFix;
  921.  
  922.   { Process the user's infix expression. }
  923.  
  924.   while (Length(InString) > 0) and not Syntax_Error do begin
  925.     Token := Next_Token(InString, Previous_Token, Syntax_Error);
  926.     if not Syntax_Error then begin
  927.  
  928.       { Numbers and variables are immediately appended to postfix. }
  929.  
  930.       if Token^.NodeType = Numeric then
  931.         Append(Tail, Token)
  932.       else if Token^.Code in ['X','Y','R','D']  then
  933.         Append(Tail, Token)
  934.  
  935.       { Left parenthesis is pushed onto the stack. }
  936.  
  937.       else if Token^.Code = '(' then
  938.         Push(TOS, Token)
  939.  
  940.       { When a right parenthesis is encountered,  operators are pulled
  941.         from the stack and appended to postfix until the corresponding
  942.         left parenthesis is encountered.  The left parenthesis is
  943.         pulled from the stack, and both parentheses are discarded. }
  944.  
  945.       else if Token^.Code = ')' then begin
  946.         while (TOS^.Code <> '(') and (TOS^.Code <> '@') do begin
  947.           Append(Tail, TOS);
  948.           Pop(TOS)
  949.         end; {while}
  950.         if TOS^.Code = '@' then
  951.           Syntax_Error := TRUE
  952.         else
  953.           Pop(TOS)
  954.       end {else if}
  955.  
  956.       { The only thing left is operators.  Operators of higher priority,
  957.         if any, are pulled from the stack and appended to postfix.  The
  958.         current operator is then pushed onto the stack. }
  959.  
  960.       else begin
  961.         while Token^.Priority <= TOS^.Priority do begin
  962.           Append(Tail, TOS);
  963.           Pop(TOS)
  964.         end; {while}
  965.         Push(TOS, Token)
  966.       end {else}
  967.     end {if}
  968.   end; {while}
  969.   if Syntax_Error then begin  { Print syntax error message if needed. }
  970.     GotoXY(18,1);
  971.     L := length(TempStr) - length(InString) + 4;
  972.     for I := 1 to L do
  973.       write(' ');
  974.     writeln('^');
  975.     writeln('Syntax error!')
  976.   end {if}
  977.  
  978.   { Remove the remaining operators from the stack and append to postfix. }
  979.  
  980.   else begin
  981.     while TOS^.Code <> '@' do begin
  982.       if TOS^.Code = '(' then begin
  983.         Syntax_Error := TRUE;
  984.         writeln('Unmatched Left Parenthesis!')
  985.       end;
  986.       Append(Tail, TOS);
  987.       Pop(TOS)
  988.     end; {while}
  989.     Pop(TOS)  { Pull NULL node from stack }
  990.   end; {else}
  991.  
  992.   Convert := PostFix^.Link;
  993.   dispose(PostFix)
  994. end; {Convert}
  995.  
  996.  
  997. {***********************  Get_Function  ******************************
  998. *                                                                    *
  999. *  This procedure asks the user to enter the expression to be        *
  1000. *  graphed.  It is entered in normal infix notation and converted    *
  1001. *  to postfix.                                                       *
  1002. *                                                                    *
  1003. *  Called by: MAIN DRIVER                                            *
  1004. *                                                                    *
  1005. *  Out Parameter: The postfix expression                             *
  1006. *  In/Out parameter: The infix expression                            *
  1007. *                                                                    *
  1008. *********************************************************************}
  1009.  
  1010. procedure Get_Function(var InFix {in/out}: Str255;
  1011.                        var PostFix {out}: NodePtr);
  1012. var
  1013.   J,               {Loop counter}
  1014.   Last: integer;   {Index of last character in infix expression}
  1015.   Temp: real;      {Used in checking for postfix errors}
  1016.   TempPtr,         {Used when returning old nodes to heap}
  1017.   OldPtr: NodePtr; {Previous postfix pointer}
  1018.   OldStr,          {Previous infix expression}
  1019.   TempStr: Str255; {Temporary storage of infix expression}
  1020.   Dummy,
  1021.   Dialog: Dialog_Ptr;  {Pointer to dialog box}
  1022.   Pushed,          {Stores way in which user exited dialog box}
  1023.   Prompt,          {Points to prompt in dialog box}
  1024.   User_Input,      {Points to user input item in dialog box}
  1025.   Quit_Btn,        {Quit button in dialog box}
  1026.   Ok_Btn: integer; {Ok button in dialog box}
  1027.  
  1028. begin
  1029.   OldStr := Infix;
  1030.   OldPtr := PostFix;
  1031.  
  1032.     { Get a valid infix expression from the user. }
  1033.  
  1034.   Clear_Screen;
  1035.   repeat
  1036.     if Res = Low then
  1037.       Dialog := New_Dialog(4,0,0,38,5)
  1038.     else
  1039.       Dialog := New_Dialog(4,0,0,78,5);
  1040.     Prompt := Add_DItem(Dialog,G_Text,None,1,1,2,1,0,256*Black);
  1041.     Set_DText(Dialog,Prompt,'Z=',3,TE_Center);
  1042.     if Res = Low then begin
  1043.       User_Input := Add_DItem(Dialog,G_FText,Editable,
  1044.                                        3,1,34,1,0,256*Black|128);
  1045.       Set_DEdit(Dialog,User_Input,'__________________________________',
  1046.                                   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX',
  1047.                                    Infix,3,TE_Left)
  1048.     end {if}
  1049.     else begin
  1050.       User_Input := Add_DItem(Dialog,G_FText,Editable,
  1051.                                  3,1,74,1,0,256*Black|128);
  1052.       Set_DEdit(Dialog,User_Input,
  1053.  '__________________________________________________________________________',
  1054.  'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX',
  1055.   Infix,3,TE_Left)
  1056.     end; {else}
  1057.     Quit_Btn := Add_DItem(Dialog,G_Button,Selectable|Exit_Btn,
  1058.                             1,3,8,1,0,0);
  1059.     Set_DText(Dialog,Quit_Btn,'ABORT',3,TE_Center);
  1060.     Ok_Btn := Add_DItem(Dialog,G_Button,Selectable|Exit_Btn,
  1061.                             12,3,8,1,0,0);
  1062.     Set_DText(Dialog,Ok_Btn,' OK ',3,TE_Center);
  1063.     Center_Dialog(Dialog);
  1064.     Set_Mouse(M_Arrow);
  1065.     Show_Mouse;
  1066.     Pushed := Do_Dialog(Dialog,User_Input);
  1067.     End_Dialog(Dialog);
  1068.     Hide_Mouse;
  1069.     Clear_Screen;
  1070.     Delete_Dialog(Dialog);
  1071.     Syntax_Error := FALSE;
  1072.     if Pushed = Ok_Btn then begin
  1073.       Get_DEdit(Dialog,User_Input,TempStr);
  1074.       if TempStr <> '' then begin  {remove trailing blanks}
  1075.         InFix := TempStr;
  1076.         Last := Length(InFix);
  1077.         while (Last > 0) AND (Infix[Last] = ' ') do begin
  1078.           delete(InFix, Last, 1);
  1079.           Last := Last - 1
  1080.         end; {while}
  1081.           {Convert to all uppercase}
  1082.         for J := 1 to Last do
  1083.           if InFix[J] in ['a'..'z'] then
  1084.             InFix[J] := chr(ord(InFix[J])-32)
  1085.       end; {if}
  1086.  
  1087.       PostFix := Convert(InFix, Syntax_Error)
  1088.     end {if}
  1089.   until NOT Syntax_Error;
  1090.   if Pushed = Ok_Btn then begin
  1091.     Must_Load1 := TRUE;
  1092.     Must_Transform := TRUE;
  1093.     while OldPtr<>NIL do begin {return previous postfix memory to heap}
  1094.       TempPtr := OldPtr;
  1095.       OldPtr := OldPtr^.Link;
  1096.       dispose(TempPtr)
  1097.     end {for}
  1098.   end {if}
  1099.   else begin
  1100.     Infix := OldStr;
  1101.     PostFix := OldPtr
  1102.   end
  1103. end; {Get_Function}
  1104.  
  1105. {****************************  Get_View  *****************************
  1106. *                                                                    *
  1107. *  Get the viewpoint and other parameters related to screen view.    *
  1108. *                                                                    *
  1109. *  Called by: MAIN DRIVER                                            *
  1110. *                                                                    *
  1111. *  Out parameters: Azimuth, Altitude, Screen_Scale, Plot_Speed,      *
  1112. *                  Draw_Top, Draw_Bottom                             *
  1113. *                                                                    *
  1114. *********************************************************************}
  1115.  
  1116. procedure Get_View(var Azimuth, Altitude, Screen_Scale: integer;
  1117.                    var Fast_Plot, Perspective, Draw_Both_Ways, Hidden_Lines,
  1118.                        Draw_Top, Draw_Bottom, Must_Transform: boolean);
  1119.  
  1120. var
  1121.   TStr: Str255;        { Temporary storage used in Draw_String }
  1122.  
  1123.   TempAz, TempAL, TempSc: integer;       { Temporary storage in }
  1124.   TempPF, TempPE, TempBW,                { case of an abort }
  1125.   TempHL, TempDT, TempDB: boolean;
  1126.  
  1127.   r: 1..2;             { 1 if color monitor used, 2 otherwise }
  1128.  
  1129. begin
  1130.   TempAz := Azimuth;
  1131.   TempAl := Altitude;
  1132.   TempSc := Screen_Scale;
  1133.   TempPF := Plot_Fast;
  1134.   TempPE := Perspective;
  1135.   TempBW := Draw_Both_Ways;
  1136.   TempHL := Hidden_Lines;
  1137.   TempDT := Draw_Top;
  1138.   TempDB := Draw_Bottom;
  1139.  
  1140.   if Res = Hi then
  1141.     r := 2
  1142.   else
  1143.     r := 1;
  1144.  
  1145.   Clear_Screen;
  1146.   Set_Mouse(M_Arrow);
  1147.   TStr := ' ';
  1148.  
  1149.   { Draw Arrows }
  1150.   TStr[1] := chr(4);
  1151.   Draw_String(96,22*r, TStr);
  1152.   Draw_String(96,102*r, TStr);
  1153.   TStr[1] := chr(3);
  1154.   Draw_String(161,22*r, TStr);
  1155.   Draw_String(161,102*r, TStr);
  1156.   TStr[1] := chr(1);
  1157.   Draw_String(129,46*r, TStr);
  1158.   TStr[1] := chr(2);
  1159.   Draw_String(129,78*r, TStr);
  1160.  
  1161.   { Draw check marks where necessary }
  1162.   TStr[1] := chr(8);
  1163.   if Fast_Plot then
  1164.     Draw_String(89,126*r, TStr);
  1165.   if Perspective then
  1166.     Draw_String(89,142*r, TStr);
  1167.   if Draw_Both_Ways then
  1168.     Draw_String(89,158*r, TStr);
  1169.   if Hidden_Lines then
  1170.     Draw_String(89,174*r, TStr);
  1171.   if Draw_Top then
  1172.     Draw_String(89,190*r, TStr);
  1173.   if Draw_Bottom then
  1174.     Draw_String(89,198*r, TStr);
  1175.  
  1176.   { Display screen text }
  1177.   GotoXY(3,3); write('Azimuth');
  1178.   GotoXY(3,15); write(Azimuth:4);
  1179.   GotoXY(8,2); write('Altitude');
  1180.   GotoXY(8,16); write(Altitude:3);
  1181.   GotoXY(13,6); write('Size');
  1182.   GotoXY(13,16); write(Screen_Scale:3,'%');
  1183.   GotoXY(16,14); write('Fast plot');
  1184.   GotoXY(18,14); write('Perspective');
  1185.   GotoXY(20,14); write('Lines both ways');
  1186.   GotoXY(22,14); write('Hidden lines');
  1187.   GotoXY(24,5); write('Graph:');
  1188.   GotoXY(24,14); write('Top');
  1189.   GotoXY(25,14); write('Bottom');
  1190.   Draw_String(253,66*r, 'ABORT');
  1191.   Text_Style(Thickened);
  1192.   Draw_String(265,104*r, 'OK');
  1193.   Text_Style(Normal);
  1194.  
  1195.   { Draw boxes }
  1196.   Frame_Rect(108,12*r,48,16*r);
  1197.   Frame_Rect(108,52*r,48,16*r);
  1198.   Frame_Rect(108,92*r,48,16*r);
  1199.   Frame_Rect(241,55*r,64,16*r);
  1200.   Frame_Rect(241,81*r,64,40*r);
  1201.  
  1202.   { Get and process any user changes }
  1203.   TStr[1] := chr(8);
  1204.   Done := FALSE;
  1205.   repeat
  1206.     Show_Mouse;
  1207.     Event := Get_Event(E_Button,1,1,1,0,FALSE,0,0,0,0,FALSE,0,0,0,0,
  1208.                        Dummy_Buffer,Dummy,Dummy,Dummy,mx,my,Dummy);
  1209.     Hide_Mouse;
  1210.     if Res = Hi then
  1211.       my := my DIV 2;
  1212.     if Event = E_Button then
  1213.       if (mx>241) AND (mx<305) then begin
  1214.         if (my>81) AND (my<121) then
  1215.           Done := TRUE
  1216.         else if (my>55) AND (my<71) then begin
  1217.           { Restore values and abort }
  1218.           Azimuth := TempAz;
  1219.           Altitude := TempAl;
  1220.           Screen_Scale := TempSc;
  1221.           Plot_Fast := TempPF;
  1222.           Perspective := TempPE;
  1223.           Draw_Both_Ways := TempBW;
  1224.           Hidden_Lines := TempHL;
  1225.           Draw_Top := TempDT;
  1226.           Draw_Bottom := TempDB;
  1227.           Done := TRUE
  1228.         end {else if}
  1229.       end {if}
  1230.       else if(my>14) AND (my<25) then begin
  1231.         if (mx>95) AND (mx<106) AND (Azimuth>-180) then begin
  1232.           Azimuth := Azimuth - 5;
  1233.           Must_Transform := TRUE
  1234.         end {if}
  1235.         else if (mx>160) AND (mx<171) AND (Azimuth<180) then begin
  1236.           Azimuth := Azimuth + 5;
  1237.           Must_Transform := TRUE
  1238.         end; {else if}
  1239.         GotoXY(3,15); write(Azimuth:4)
  1240.       end {else if}
  1241.       else if (mx>128) AND (mx<139) AND (my<81) then begin
  1242.         if (my>38) AND (my<49) AND (Altitude<90) then begin
  1243.           Altitude := Altitude + 5;
  1244.           Must_Transform := TRUE
  1245.         end {if}
  1246.         else if (my>70) AND (my<81) AND (Altitude>-90) then begin
  1247.           Altitude := Altitude - 5;
  1248.           Must_Transform := TRUE
  1249.         end; {else if}
  1250.         GotoXY(8,16); write(Altitude:3)
  1251.       end {else if}
  1252.       else if(my>94) AND (my<105) then begin
  1253.         if (mx>95) AND (mx<106) AND (Screen_Scale > 50) then begin
  1254.           Screen_Scale := Screen_Scale - 10;
  1255.           Must_Transform := TRUE
  1256.         end {if}
  1257.         else if (mx>160) AND (mx<171) AND (Screen_Scale < 200) then begin
  1258.           Screen_Scale := Screen_Scale + 10;
  1259.           Must_Transform := TRUE
  1260.         end; {else if}
  1261.         GotoXY(13,16); write(Screen_Scale:3)
  1262.       end {else if}
  1263.       else if(mx>104) AND (mx<177) AND (my>120) AND (my<129) then
  1264.         if Fast_Plot then begin
  1265.           Fast_Plot := FALSE;
  1266.           GotoXY(16,13); write(' ');
  1267.           GotoXY(16,12); write(' ')
  1268.         end {if}
  1269.         else begin
  1270.           Fast_Plot := TRUE;
  1271.           Draw_String(89,126*r, TStr)
  1272.         end {else}
  1273.       else if (mx>104) AND (mx<193) AND (my>136) AND (my<145) then
  1274.         if Perspective then begin
  1275.           Perspective := FALSE;
  1276.           GotoXY(18,13); write(' ');
  1277.           GotoXY(18,12); write(' ');
  1278.           Must_Transform := TRUE
  1279.         end {if}
  1280.         else begin
  1281.           Perspective := TRUE;
  1282.           Draw_String(89,142*r, TStr);
  1283.           Must_Transform := TRUE
  1284.         end {else}
  1285.       else if (mx>104) AND (mx<225) AND (my>152) AND (my<161) then
  1286.         if Draw_Both_Ways then begin
  1287.           Draw_Both_Ways := FALSE;
  1288.           GotoXY(20,13); write(' ');
  1289.           GotoXY(20,12); write(' ')
  1290.         end {if}
  1291.         else begin
  1292.           Draw_Both_Ways := TRUE;
  1293.           Draw_String(89,158*r, TStr)
  1294.         end {else}
  1295.       else if (mx>104) AND (mx<241) AND (my>168) AND (my<177) then
  1296.         if Hidden_Lines then begin
  1297.           Hidden_Lines := FALSE;
  1298.           GotoXY(22,13); write(' ');
  1299.           GotoXY(22,12); write(' ')
  1300.         end {if}
  1301.         else begin
  1302.           Hidden_Lines := TRUE;
  1303.           Draw_String(89,174*r, TStr)
  1304.         end {else}
  1305.       else if (mx>104) AND (mx<129) AND (my>184) AND (my<193) then
  1306.         if Draw_Top then begin
  1307.           Draw_Top := FALSE;
  1308.           GotoXY(24,13); write(' ');
  1309.           GotoXY(24,12); write(' ')
  1310.         end {if}
  1311.         else begin
  1312.           Draw_Top := TRUE;
  1313.           Draw_String(89,190*r, TStr)
  1314.         end {else}
  1315.       else if (mx>104) AND (mx<153) AND (my>192) AND (my<200) then
  1316.         if Draw_Bottom then begin
  1317.           Draw_Bottom := FALSE;
  1318.           GotoXY(25,13); write(' ');
  1319.           GotoXY(25,12); write(' ')
  1320.         end {if}
  1321.         else begin
  1322.           Draw_Bottom := TRUE;
  1323.           Draw_String(89,198*r, TStr)
  1324.         end {else}
  1325.   until Done
  1326. end; {Get_View}
  1327.  
  1328. {************************  Evaluate_Function  ************************
  1329. *                                                                    *
  1330. *  Evaluates the Postfix expression                                  *
  1331. *                                                                    *
  1332. *  Called by: Load_Point_Array                                       *
  1333. *                                                                    *
  1334. *  Variables are accessed globally to reduce execution time          *
  1335. *                                                                    *
  1336. *********************************************************************}
  1337.  
  1338. function Evaluate_Function(Head {in}: NodePtr): real;
  1339.  
  1340. var
  1341.   TOS: 0..100;
  1342.   Stack: array [1..100] of real;
  1343.   Cosine_Val: real;
  1344.   Temp: integer;
  1345.   Undefined,
  1346.   PostFix_Error: boolean;
  1347. begin
  1348.  
  1349.   { Initialize flags and data stack. }
  1350.  
  1351.   PostFix_Error := FALSE;
  1352.   Undefined := FALSE;
  1353.   TOS := 0;
  1354.  
  1355.   { Process postfix expression }
  1356.  
  1357.   while (Head<> NIL) and not PostFix_Error and not Undefined do begin
  1358.  
  1359.     { Push numbers onto the stack, }
  1360.  
  1361.     if Head^.NodeType = Numeric then begin
  1362.       TOS := TOS + 1;
  1363.       Stack[TOS] := Head^.Value
  1364.     end {if}
  1365.  
  1366.     { or push the value of a variable onto the stack, }
  1367.  
  1368.     else if Head^.Code = 'X' then begin
  1369.       TOS := TOS + 1;
  1370.       Stack[TOS] := x
  1371.     end {else if}
  1372.     else if Head^.Code = 'Y' then begin
  1373.       TOS := TOS + 1;
  1374.       Stack[TOS] := y
  1375.     end {else if}
  1376.     else if Head^.Code = 'R' then begin
  1377.       TOS := TOS + 1;
  1378.       Stack[TOS] := r
  1379.     end {else if}
  1380.     else if Head^.Code = 'D' then begin
  1381.       TOS := TOS + 1;
  1382.       Stack[TOS] := d
  1383.     end {else if}
  1384.  
  1385.     { or apply negation operator, }
  1386.  
  1387.     else if Head^.Priority = 3 then
  1388.       if TOS>0 then
  1389.         Stack[TOS] := -Stack[TOS]
  1390.       else
  1391.         PostFix_Error := TRUE
  1392.     { or apply function to TOS element, }
  1393.  
  1394.     else if Head^.Priority = 5 then
  1395.       if TOS>0 then
  1396.         case Head^.Code of
  1397.           'A': Stack[TOS] := ABS(Stack[TOS]);
  1398.           'C': Stack[TOS] := COS(Stack[TOS]);
  1399.           'E': if Stack[TOS] < -50 then
  1400.                  Stack[TOS] := 0
  1401.                else if Stack[TOS] < 50 then
  1402.                  Stack[TOS] := EXP(Stack[TOS])
  1403.                else
  1404.                  Undefined := TRUE;
  1405.           'L': if Stack[TOS] > 0 then
  1406.                  Stack[TOS] := LN(Stack[TOS])
  1407.                else
  1408.                  Undefined := TRUE;
  1409.           'Q': if Stack[TOS] >= 0 then
  1410.                  Stack[TOS] := SQRT(Stack[TOS])
  1411.                else
  1412.                  Undefined := TRUE;
  1413.           'S': Stack[TOS] := SIN(Stack[TOS]);
  1414.           'T': begin
  1415.                  Cosine_Val := COS(Stack[TOS]);
  1416.                  if ABS(Cosine_Val) > 0.000001 then
  1417.                    Stack[TOS] := SIN(Stack[TOS])/COS(Stack[TOS])
  1418.                  else
  1419.                    Undefined := TRUE
  1420.                end {case option}
  1421.         end {case}
  1422.       else
  1423.         PostFix_Error := TRUE
  1424.  
  1425.     { or else the token is a binary operator which is applied to top
  1426.       two stack elements and the result replaces both of them. }
  1427.  
  1428.     else if TOS>1 then begin
  1429.       TOS := TOS - 1;
  1430.       case Head^.Code of
  1431.         '+': Stack[TOS] := Stack[TOS] + Stack[TOS+1];
  1432.         '-': Stack[TOS] := Stack[TOS] - Stack[TOS+1];
  1433.         '*': Stack[TOS] := Stack[TOS] * Stack[TOS+1];
  1434.         '/': if ABS(Stack[TOS+1]) > 0.000001 then
  1435.                Stack[TOS] := Stack[TOS] / Stack[TOS+1]
  1436.              else
  1437.                Undefined := TRUE;
  1438.  
  1439.         { The program can handle two types of exponentiation.  If the
  1440.           base (TOS) is positive, the normal process of using EXP and LN
  1441.           functions is used.  If the base is negative and the exponent
  1442.           is an integer, then we have to apply some algebraic trickery
  1443.           first.  If the base has a value of zero, the result is set
  1444.           to zero as well. }
  1445.  
  1446.         '^': if Stack[TOS] > 0 then
  1447.                Stack[TOS] := EXP(Stack[TOS+1]*LN(Stack[TOS]))
  1448.              else if Stack[TOS] < 0 then begin
  1449.                Temp := round(Stack[TOS+1]);
  1450.                if abs(Temp - Stack[TOS+1]) < 0.000001 then begin
  1451.                  Stack[TOS] := EXP(Stack[TOS+1]*LN(-Stack[TOS]));
  1452.                  if Odd(Temp) then
  1453.                    Stack[TOS] := -Stack[TOS]
  1454.                end {if}
  1455.                else
  1456.                  Undefined := TRUE
  1457.              end {else if}
  1458.              else
  1459.                Stack[TOS] := 0
  1460.       end {case}
  1461.     end {if}
  1462.  
  1463.     { If we get this far, then postfix token is invalid.  Not likely to
  1464.       happen. }
  1465.  
  1466.     else
  1467.       PostFix_Error := TRUE;
  1468.  
  1469.     Head:= Head^.Link  { Move to next token in postfix. }
  1470.   end; {while}
  1471.  
  1472.   { At the end, there should be only one element remaining on the stack,
  1473.     namely the final result.  Otherwise, the postfix expression is invalid.
  1474.     We skip this if the function is undefined for the current value of X. }
  1475.  
  1476.   if not Undefined then begin
  1477.     if TOS = 1 then
  1478.       if Stack[TOS] > Max_Z then
  1479.         Evaluate_Function := Max_Z
  1480.       else if Stack[TOS] < Min_Z then
  1481.         Evaluate_Function := Min_Z
  1482.       else
  1483.         Evaluate_Function := Stack[TOS]
  1484.     else
  1485.       PostFix_Error := TRUE;
  1486.  
  1487.     { Print error message if necessary. }
  1488.  
  1489.     if PostFix_Error then begin
  1490.       writeln('Postfix error detected!');
  1491.       writeln;
  1492.       writeln('This is usually caused by too few');
  1493.       writeln('operators.  Check for missing arithmetic');
  1494.       writeln('symbols; especially multiplication "*".')
  1495.     end {if}
  1496.   end {if}
  1497.   else
  1498.     Evaluate_Function := Max_Z
  1499. end; {Evaluate_Function}
  1500.  
  1501.  
  1502. {**********************  Load_Point_Array  ***************************
  1503. *                                                                    *
  1504. *  Load the logical coordinate point arrays.                         *
  1505. *                                                                    *
  1506. *  Called by: MAIN DRIVER                                            *
  1507. *                                                                    *
  1508. *  Accessed as global variables: lx, ly, lz, XLim, YLim, Grid_Scale, *
  1509. *                                Must_Load1, Must_Load2,             *
  1510. *                                Must_Transform                      *
  1511. *                                                                    *
  1512. *********************************************************************}
  1513.  
  1514. procedure Load_Point_Array;
  1515.  
  1516. var
  1517.   i,j: integer; { Loop counters }
  1518.  
  1519. begin
  1520.   Clear_Screen;
  1521.   Draw_String(0,100,'CALCULATING POINT COORDINATES...');
  1522.   Set_Mouse(M_Bee);
  1523.   Show_Mouse;
  1524.  
  1525.   Max_Z := 2*Grid_Scale*XLim;
  1526.   Min_Z := -Max_Z;
  1527.  
  1528.   { Calculate values for logical coordinates }
  1529.   for I := -XLim to XLim do
  1530.     for j := -YLim to YLim do begin
  1531.       x := I*Grid_Scale;
  1532.       y := J*Grid_Scale;
  1533.       r := x*x+y*y;
  1534.       d := sqrt(r);
  1535.       lz[i,j] := Evaluate_Function(PostFix);
  1536.       lx[i,j] := x;
  1537.       ly[i,j] := y
  1538.     end; {for}
  1539.  
  1540.   Hide_Mouse;
  1541.   Must_Load1 := FALSE;
  1542.   Must_Load2 := FALSE;
  1543.   Must_Transform := TRUE
  1544. end; {Load_Point_Array}
  1545.  
  1546. {********************  Transform_Point_Array  ************************
  1547. *                                                                    *
  1548. *  Transform the coordinate arrays into screen coordinates.  Scale   *
  1549. *  and viewpoint are taken into account.                             *
  1550. *                                                                    *
  1551. *  Called by: MAIN DRIVER                                            *
  1552. *                                                                    *
  1553. *  Accessed as global variables:  Azimuth, Altitude, Screen_Scale,   *
  1554. *        Grid_Scale, XLim, YLim, lx, ly, lx, sx, sy, Perspective,    *
  1555. *        X_Center, Y_Center, SF                                      *
  1556. *                                                                    *
  1557. *********************************************************************}
  1558.  
  1559. procedure Transform_Point_Array;
  1560.  
  1561. var
  1562.   i,j : integer;  { Loop counters }
  1563.   Temp,           { Temporary storage }
  1564.   AzRad,          { Azimuth in radians }
  1565.   AltRad,         { Altitude in radians }
  1566.   NewZ,           { Transformed z-coordinate }
  1567.   Display_Scale,  { Scaling factor used in drawing graph }
  1568.   pf,             { Perspective factor }
  1569.   c1,s1,c2,s2,    { cos(AzRad), sin(AzRad), cos(AltRad), sin(AltRad) }
  1570.   mf1,mf2: real;  { Multiplicative factors to create graph that will nearly }
  1571.                   { fill the screen. }
  1572.  
  1573. begin
  1574.   Clear_Screen;
  1575.   Draw_String(0,100, 'TRANSFORMING THE POINTS...');
  1576.   Set_Mouse(M_Bee);
  1577.   Show_Mouse;
  1578.  
  1579.   AzRad := Azimuth*Pi/180;
  1580.   c1 := cos(AzRad);
  1581.   s1 := sin(AzRad);
  1582.  
  1583.   AltRad := Altitude*Pi/180;
  1584.   c2 := cos(AltRad);
  1585.   s2 := sin(AltRad);
  1586.  
  1587.   Display_Scale := Screen_Scale/100;
  1588.   mf1 := 0.90*X_Center*Display_Scale/(XLim*Grid_Scale);
  1589.   mf2 := mf1*SF;
  1590.  
  1591.   { Transform logical to screen coordinates }
  1592.   for I := -XLim to XLim do
  1593.     for j := -YLim to YLim do begin
  1594.       Temp := lx[i,j]*s1-ly[i,j]*c1;
  1595.       NewZ := c2*Temp+lz[i,j]*s2;
  1596.       if Perspective then
  1597.         pf := 1/(1-NewZ/(140*Grid_Scale))
  1598.       else
  1599.         pf := 1;
  1600.       sx[i,j] := X_Center+round(mf1*pf*(lx[i,j]*c1+ly[i,j]*s1));
  1601.       sy[i,j] :=Y_Center-round(mf2*pf*(s2*(-Temp)+lz[i,j]*c2))
  1602.     end; {for}
  1603.  
  1604.   Hide_Mouse;
  1605.   Must_Transform := FALSE
  1606. end; { Transform_Point_Array }
  1607.  
  1608. {************************  Draw Line  ********************************
  1609. *                                                                    *
  1610. *  This procedure draws the visible portion(s) of the line between   *
  1611. *  the two points passed in as parameters.  The maximum and minimum  *
  1612. *  arrays are updated as necessary.                                  *
  1613. *                                                                    *
  1614. *  Called by: Draw_Graph                                             *
  1615. *                                                                    *
  1616. *  In parameters:  The coordinates of two points                     *
  1617. *                                                                    *
  1618. *  Global variables accessed: Max, Min, Draw_Top, Draw_Bottom,       *
  1619. *                             Plot_Fast                              *
  1620. *                                                                    *
  1621. *********************************************************************}
  1622.  
  1623. procedure Draw_Line(x1,y1,x2,y2: integer);
  1624.  
  1625. var
  1626.   f1 ,f2: 0..2;    { Flag = 2  ===>  Point visible above }
  1627.                    { Flag = 1  ===>  Point visible below }
  1628.                    { Flag = 0  ===>  Point is hidden     }
  1629.  
  1630.   dx, dy,          { delta x = x2 - x1, delta y = y2 - y1 }
  1631.  
  1632.   tx, ty: integer; { Temporary storage }
  1633.  
  1634.   inc,             { Temporary storaged }
  1635.   incx, incy,      { Increments used to plot line pixel by pixel }
  1636.                    { when only part of line is visible.          }
  1637.  
  1638.   t1, t2,          { Horizontal and vertical distance from first }
  1639.                    { point.  Used when plotting pixel by pixel.  }
  1640.  
  1641.   slope: real;     { Slope of line segment between points }
  1642.  
  1643.         {--------------  Adjust_Min  ------------------
  1644.         |                                              |
  1645.         | Adjust the array indicating the upper limit  |
  1646.         | of the graph.                                |
  1647.         |                                              |
  1648.         | Called by: Draw_Line                         |
  1649.         |                                              |
  1650.         | Global variables accessed: x1,x2,y1,y2       |
  1651.         |                                              |
  1652.          ----------------------------------------------}
  1653.  
  1654.         procedure Adjust_Min;
  1655.  
  1656.         var
  1657.           x: integer;  {Loop counter}
  1658.  
  1659.         begin
  1660.           if x1>x2 then  {Line goes left to right}
  1661.             for x := x1 downto x2 do begin
  1662.               min[x] := y1 + round((x-x1)*slope);
  1663.               if max[x] = minint then
  1664.                 max[x] := min[x]
  1665.             end {for}
  1666.           else           {Line goes right to left}
  1667.             for x := x1 to x2 do begin
  1668.               min[x] := y1 + round((x-x1)*slope);
  1669.               if max[x] = minint then
  1670.                 max[x] := min[x]
  1671.             end {for}
  1672.         end; {Adust_Min}
  1673.  
  1674.         {--------------  Adjust_Max  ------------------
  1675.         |                                              |
  1676.         | Adjust the array indicating the lower limit  |
  1677.         | of the graph.                                |
  1678.         |                                              |
  1679.         | Called by: Draw_Line                         |
  1680.         |                                              |
  1681.         | Global variables accessed: x1,x2,y1,y2       |
  1682.         |                                              |
  1683.          ----------------------------------------------}
  1684.  
  1685.         procedure Adjust_Max;
  1686.  
  1687.         var
  1688.           x: integer;  {Loop counter}
  1689.  
  1690.         begin
  1691.           if x1>x2 then  {Line goes left to right}
  1692.             for x := x1 downto x2 do begin
  1693.               max[x] := y1 + round((x-x1)*slope);
  1694.               if min[x] = maxint then
  1695.                 min[x] := max[x]
  1696.             end {for}
  1697.           else           {Line goes right to left}
  1698.             for x := x1 to x2 do begin
  1699.               max[x] := y1 + round((x-x1)*slope);
  1700.               if min[x] = maxint then
  1701.                 min[x] := max[x]
  1702.             end {for}
  1703.         end; {Adust_Max}
  1704.  
  1705.         {--------------  Swap_Points  -----------------
  1706.         |                                              |
  1707.         | Swap the two input points and associated     |
  1708.         | variables.  All are accessed as global       |
  1709.         | values within Draw_Line.                     |
  1710.         |                                              |
  1711.         | Called by: Draw_Line                         |
  1712.         |                                              |
  1713.         | Global variables accessed: x1,x2,y1,y2,f1,   |
  1714.         |                            f2, incx, incy    |
  1715.         |                                              |
  1716.          ----------------------------------------------}
  1717.  
  1718.         procedure Swap_Points;
  1719.  
  1720.         var
  1721.           TempInt: integer;
  1722.  
  1723.         begin
  1724.           TempInt := x1;
  1725.           x1 := x2;
  1726.           x2 := TempInt;
  1727.  
  1728.           TempInt := y1;
  1729.           y1 := y2;
  1730.           y2 := TempInt;
  1731.  
  1732.           TempInt := f1;
  1733.           f1 := f2;
  1734.           f2 := TempInt;
  1735.  
  1736.           incx := -incx;
  1737.           incy := -incy
  1738.         end; {Swap_Points}
  1739.  
  1740.         {----------------------------------------------}
  1741.  
  1742. begin
  1743.  
  1744.   { Check visibility of first point }
  1745.  
  1746.   if y1 <= min[x1] then  { point is visible above graph }
  1747.     f1 := 2
  1748.   else if y1 >= max[x1] then  { point is visible below graph }
  1749.     f1 := 1
  1750.   else   { point is hidden }
  1751.     f1 := 0;
  1752.  
  1753.   { Check visibility of second point }
  1754.  
  1755.   if f1 <> 1 then  { check for visible above graph first }
  1756.     if y2 <= min[x2] then  { visible above }
  1757.       f2 := 2
  1758.     else if y2 >= max[x2] then  { visible below }
  1759.       f2 := 1
  1760.     else  { hidden }
  1761.       f2 := 0
  1762.   else   { Since first point was below, check second point for below first }
  1763.     if y2 >= max[x2] then  { below }
  1764.       f2 := 1
  1765.     else if y2 <= min[x2] then  { above }
  1766.       f2 := 2
  1767.     else   { hidden }
  1768.       f2:=0;
  1769.  
  1770.   dx := x2 - x1;
  1771.   dy := y2 - y1;
  1772.  
  1773.   if (f1 | f2) > 0 then  {at least one point is visible}
  1774.     if abs(dx)+abs(dy) = 0 then  { Line consists of single point }
  1775.       Plot(x1,y1)
  1776.     else begin
  1777.       if (f1 = f2) AND (dx <> 0) AND Plot_Fast then begin
  1778.         { Draw line segment }
  1779.         slope := dy/dx;
  1780.         if (f1 = 2) then begin  {both points above the graph}
  1781.           if Draw_Top then begin
  1782.             Line_Color(1);
  1783.             line(x1,y1,x2,y2)
  1784.           end; {if}
  1785.           Adjust_Min
  1786.         end {if}
  1787.         else begin  {both points below the graph}
  1788.           if Draw_Bottom then begin
  1789.             if Res <> Hi then
  1790.               Line_Color(2);
  1791.             line(x1,y1,x2,y2)
  1792.           end; {if}
  1793.           Adjust_Max
  1794.         end {else if}
  1795.       end {if}
  1796.       else begin
  1797.         if abs(dy)>abs(dx) then
  1798.           inc := 1/abs(dy)
  1799.         else
  1800.           inc := 1/abs(dx);
  1801.         incx := inc*dx;
  1802.         incy := inc*dy;
  1803.  
  1804.         if ((f1=2) OR (f2 = 2)) AND Draw_Top then begin
  1805.           { One of the points is visible above the graph }
  1806.           if y1<y2 then
  1807.             Swap_Points;  { so the line goes from (x1,y1) UP to (x2,y2) }
  1808.           line_color(1);
  1809.           t1 := 0;
  1810.           t2 := 0;
  1811.           repeat  { Move along line segment pixel by pixel }
  1812.             tx := x1 + round(t1);
  1813.             ty := y1 + round(t2);
  1814.             if ty<min[tx] then begin  { pixel is visible so plot it }
  1815.               plot(tx,ty);
  1816.               min[tx] := ty;          { and adjust Min array }
  1817.               if max[tx] = minint then
  1818.                 max[tx] := ty
  1819.             end; {if}
  1820.             t1 := t1 + incx;
  1821.             t2 := t2 + incy
  1822.           until (tx = x2);  { you're in same vertical column as (x2,y2)  }
  1823.                             { so plot remaining vertical segment, if any }
  1824.           if x1<x2 then
  1825.             tx := x2-1
  1826.           else
  1827.             tx := x2+1;
  1828.           repeat
  1829.             if (ty<min[x2]) OR (ty <= min[tx]) then
  1830.               plot(x2,ty);
  1831.             ty := ty-1
  1832.           until ty<y2;
  1833.           if f2 = 2 then begin
  1834.             min[x2] := y2;
  1835.             if max[x2] = minint then
  1836.               max[x2] := y2
  1837.           end {if}
  1838.         end; {if}
  1839.  
  1840.         if ((f1 = 1) OR (f2 = 1)) AND Draw_Bottom then begin
  1841.           { One of the points is visible below the graph }
  1842.           if y1>y2 then
  1843.             Swap_Points;  { so line goes from (x1,y1) DOWN to (x2,y2) }
  1844.           if Res <> Hi then
  1845.             line_color(2);
  1846.           t1 := 0;
  1847.           t2 := 0;
  1848.           repeat  { Check line pixel by pixel }
  1849.             tx := x1 + round(t1);
  1850.             ty := y1 + round(t2);
  1851.             if ty>max[tx] then begin   { pixel is visible so plot it }
  1852.               plot(tx,ty);
  1853.               max[tx] := ty;           { and adust Max array }
  1854.               if min[tx] = maxint then
  1855.                 min[tx] := ty
  1856.             end; {if}
  1857.             t1 := t1+incx;
  1858.             t2 := t2 +incy
  1859.           until (tx=x2);   { you're in same vertical column as (x2,y2)  }
  1860.                            { so plot remaining vertical segment, if any }
  1861.           if x1<x2 then
  1862.             tx := x2-1
  1863.           else
  1864.             tx := x2+1;
  1865.           repeat
  1866.             if (ty > max[x2]) OR (ty > max[tx]) then
  1867.               plot(x2,ty);
  1868.             ty := ty+1
  1869.           until ty>y2;
  1870.           if f2 = 1 then begin
  1871.             max[x2] := y2;
  1872.             if min[x2] = maxint then
  1873.               min[x2] := y2
  1874.           end {if}
  1875.         end {if}
  1876.       end {else}
  1877.     end; {else}
  1878.   Line_Color(1)
  1879. end;
  1880.  
  1881. {***************************  Draw_Graph  ****************************
  1882. *                                                                    *
  1883. *  Draw the graph                                                    *
  1884. *                                                                    *
  1885. *  Called by: MAIN DRIVER                                            *
  1886. *                                                                    *
  1887. *  Variables accessed globally: sx, sy, Azimuth, Intensity, Res      *
  1888. *                               Draw_Both_Ways, XLim, YLim           *
  1889. *                                                                    *
  1890. *********************************************************************}
  1891.  
  1892. procedure Draw_Graph;
  1893.  
  1894. var
  1895.   XStart, Xstep, Xstop,  { Values for x-coordinate loops }
  1896.   YStart, YStep, YStop,  { Values for y-coordinate loops }
  1897.   NextI, NextJ,          { Next row,  next column }
  1898.   Zone,                  { Octant from which graph is viewed }
  1899.   I, J: integer;   { Loop counters }
  1900.   T: array [1..3] of integer;
  1901.  
  1902. begin
  1903.   if Res <> Hi then {Load graph colors}
  1904.     for I := 0 to 1 do begin
  1905.       for J := 1 to 3 do
  1906.         T[J] := 60 + 125*Intensity[I,J];
  1907.       Set_Color(I,T[1],T[2],T[3])
  1908.     end; {for}
  1909.  
  1910.   { Find Zone }
  1911.  
  1912.   if Azimuth > 135 then Zone := 1
  1913.   else if Azimuth > 90 then Zone := 2
  1914.   else if Azimuth > 45 then Zone := 3
  1915.   else if Azimuth >  0 then Zone := 4
  1916.   else if Azimuth >-45 then Zone := 5
  1917.   else if Azimuth >-90 then Zone := 6
  1918.   else if Azimuth>-135 then Zone := 7
  1919.   else Zone := 8;
  1920.  
  1921.   { Initialize Min and Max arrays }
  1922.  
  1923.   for I := -640 to 1280 do begin
  1924.     max[I] := minint;
  1925.     min[I] := maxint
  1926.   end; {for}
  1927.  
  1928.   { Set up loop parameters }
  1929.  
  1930.   if Zone in [1,2,7,8] then begin
  1931.     YStart := YLim;
  1932.     YStep := -1
  1933.   end {if}
  1934.   else begin
  1935.     YStart := -YLim;
  1936.     YStep := 1
  1937.   end; {else}
  1938.   if Zone in [1,2,3,4] then begin
  1939.     XStart := XLim;
  1940.     XStep := -1
  1941.   end {if}
  1942.   else begin
  1943.     XStart := -XLim;
  1944.     XStep := 1
  1945.   end; {else}
  1946.  
  1947.   { Draw the graph }
  1948.  
  1949.   Clear_Screen;
  1950.   if Zone in [1,4,5,8] then begin
  1951.     J := YStart;
  1952.     YStop := -YStart + YStep;
  1953.     repeat
  1954.       I := XStart;
  1955.       XStop := -XStart;
  1956.       repeat
  1957.         NextI := I + XStep;
  1958.         Draw_Line(sx[I,J],sy[I,J],sx[NextI,J],sy[NextI,J]);
  1959.         I := NextI
  1960.       until I = XStop;
  1961.       if (J <> -YStart) AND Draw_Both_Ways then begin
  1962.         I := XStart;
  1963.         XStop := XStop + XStep;
  1964.         NextJ := J + YStep;
  1965.         repeat
  1966.           Draw_Line(sx[I,J],sy[I,J],sx[I,NextJ],sy[I,NextJ]);
  1967.           I := I + XStep
  1968.         until I = XStop
  1969.       end; {if}
  1970.       J := J + YStep;
  1971.     until J = YStop
  1972.   end {if}
  1973.   else begin
  1974.     I := XStart;
  1975.     XStop := -XStart + XStep;
  1976.     repeat
  1977.       J := YStart;
  1978.       YStop := -YStart;
  1979.       repeat
  1980.         NextJ := J + YStep;
  1981.         Draw_Line(sx[I,J],sy[I,J],sx[I,NextJ],sy[I,NextJ]);
  1982.         J := NextJ
  1983.       until J = YStop;
  1984.       if (I <> -XStart) AND Draw_Both_Ways then begin
  1985.         J := YStart;
  1986.         YStop := YStop + YStep;
  1987.         NextI := I + XStep;
  1988.         repeat
  1989.           Draw_Line(sx[I,J],sy[I,J],sx[NextI,J],sy[NextI,J]);
  1990.           J := J + YStep
  1991.         until J = YStop
  1992.       end; {if}
  1993.       I := I + XStep;
  1994.     until I = XStop
  1995.   end; {else}
  1996.   repeat
  1997.     Event := Get_Event(E_Button,1,1,1,0,FALSE,0,0,0,0,FALSE,0,0,0,0,
  1998.                        Dummy_Buffer,Dummy,Dummy,Dummy,Dummy,Dummy,Dummy);
  1999.   until Event = E_Button;
  2000.  
  2001.   if Res <> Hi then begin
  2002.     Set_Color(0,1000,1000,1000);
  2003.     Set_Color(1,0,0,0)
  2004.   end {if}
  2005. end; {Draw_Graph}
  2006.  
  2007. {***********************  Quick_Draw_Graph  **************************
  2008. *                                                                    *
  2009. *  Draw the graph without worrying about hidden lines.               *
  2010. *                                                                    *
  2011. *  Called by: MAIN DRIVER                                            *
  2012. *                                                                    *
  2013. *  Variables accessed globally: sx, sy, Azimuth, Intensity, Res,     *
  2014. *                               XLim, YLim                           *
  2015. *                                                                    *
  2016. *********************************************************************}
  2017.  
  2018. procedure Quick_Draw_Graph;
  2019.  
  2020. var
  2021.   I, J: integer;   { Loop counters }
  2022.   T: array [1..3] of integer;
  2023.  
  2024. begin
  2025.   Clear_Screen;
  2026.  
  2027.   if Res <> Hi then { Load graph colors }
  2028.     for I := 0 to 1 do begin
  2029.       for J := 1 to 3 do
  2030.         T[J] := 60 + 125*Intensity[I,J];
  2031.       Set_Color(I,T[1],T[2],T[3])
  2032.     end; {for}
  2033.  
  2034.   for I := -XLim to XLim do begin
  2035.     Plot(sx[I,-Ylim], sy[I,-YLim]);
  2036.     for J := -YLim+1 to YLim do
  2037.       Line_to(sx[I,J], sy[I,J])
  2038.   end; {for}
  2039.  
  2040.   for J := -YLim to Ylim do begin
  2041.     Plot(sx[-XLim,J],sy[-XLim,J]);
  2042.     for I := -XLim to XLim do
  2043.       Line_to(sx[I,J], sy[I,J])
  2044.   end; {for}
  2045.  
  2046.   repeat
  2047.     Event := Get_Event(E_Button,1,1,1,0,FALSE,0,0,0,0,FALSE,0,0,0,0,
  2048.                        Dummy_Buffer,Dummy,Dummy,Dummy,Dummy,Dummy,Dummy);
  2049.   until Event = E_Button;
  2050.  
  2051.   if Res <> Hi then begin
  2052.     Set_Color(0,1000,1000,1000);
  2053.     Set_Color(1,0,0,0)
  2054.   end {if}
  2055. end; {Quick_Draw_Graph}
  2056.  
  2057.  
  2058. {****************************  Show_Help  ****************************
  2059. *                                                                    *
  2060. *  Display help screen for main menu.                                *
  2061. *                                                                    *
  2062. *  Called by: MAIN DRIVER                                            *
  2063. *                                                                    *
  2064. *********************************************************************}
  2065.  
  2066. procedure Show_Help;
  2067.  
  2068. var
  2069.   Quit: boolean;
  2070.   Help_Screen: integer;
  2071.   r: 1..2;   { 1 if color monitor used, 2 otherwise }
  2072.  
  2073. begin
  2074.   Help_Screen := 1;
  2075.   Quit := FALSE;
  2076.   if Res = Hi then
  2077.     r := 2
  2078.   else
  2079.     r := 1;
  2080.  
  2081.   repeat
  2082.     Clear_Screen;
  2083.     GotoXY(1,1);
  2084.     case Help_Screen of  { Print current help screen }
  2085.       1: begin
  2086.            writeln('This program draws graphs of three');
  2087.            writeln('dimensional functions of the type');
  2088.            writeln('z = f(x,y).  You can enter your own');
  2089.            writeln('functions by simply typing them in.');
  2090.            writeln;
  2091.            writeln('You control every aspect of the display');
  2092.            writeln('including colors, size, and viewpoint.');
  2093.            writeln;
  2094.            writeln('Clicking on an ABORT button will cancel');
  2095.            writeln('any changes you''ve made in that option');
  2096.            writeln('and return you to the main menu.  It');
  2097.            writeln('will also prevent the program from');
  2098.            writeln('thinking it needs to recalculate or');
  2099.            writeln('transform the point coordinates.')
  2100.          end;
  2101.       2: begin
  2102.            writeln('                 COLOR');
  2103.            writeln;
  2104.            writeln('You can choose the background color,');
  2105.            writeln('as well as the color of the top and');
  2106.            writeln('bottom surfaces of the graph.  Each');
  2107.            writeln('register (red, green, blue) has a value');
  2108.            writeln('from 0 (absence of that color) to 7');
  2109.            writeln('(full intensity).  Clicking on an arrow');
  2110.            writeln('above an intensity value will raise it');
  2111.            writeln('by one.  (Raising a 7 will make it 0.)');
  2112.            writeln('Clicking on an arrow below an intensity');
  2113.            writeln('value will decrease the value by one.');
  2114.            writeln('(Lowering a 0 will make it 7.)');
  2115.            writeln;
  2116.            writeln('In the event you should accidently make');
  2117.            writeln('the background and text colors the same,');
  2118.            writeln('just press the escape (Esc) key.')
  2119.          end;
  2120.       3: begin
  2121.            writeln('                 GRID');
  2122.            writeln;
  2123.            writeln('The grid scale is the scale per grid');
  2124.            writeln('line.  Acceptable values range from');
  2125.            writeln('0.10 to 4.00 in steps of 0.05.');
  2126.            writeln;
  2127.            writeln('You can also choose the number of grid');
  2128.            writeln('lines used to draw the graph.  The');
  2129.            writeln('X and Y limits are the number of grid');
  2130.            writeln('lines on the corresponding POSITIVE');
  2131.            writeln('axis.  The actual number of grid lines');
  2132.            writeln('is given by 2*Limit+1.');
  2133.            writeln;
  2134.            writeln('The maximum coordinate value is found');
  2135.            writeln('by multiplying the Limit times the grid');
  2136.            writeln('scale.');
  2137.            writeln;
  2138.            writeln('With the default values, there are 33');
  2139.            writeln('grid lines in each direction with values');
  2140.            writeln('ranging from -4 to 4 in steps of 0.25.')
  2141.          end;
  2142.       4: begin
  2143.            writeln('               FUNCTION');
  2144.            writeln;
  2145.            writeln('The program recognizes the following');
  2146.            writeln('mathematical functions: ABS, COS, SIN,');
  2147.            writeln('TAN, LN, EXP, and SQR.  When entering');
  2148.            writeln('your function use the same syntax you');
  2149.            writeln('would use in BASIC.');
  2150.            writeln;
  2151.            writeln('The program will allow you to use four');
  2152.            writeln('variables:');
  2153.            writeln('     X = x-coordinate');
  2154.            writeln('     Y = y-coordinate');
  2155.            writeln('     D = distance from (x,y) to origin');
  2156.            writeln('     R = D*D (D squared)');
  2157.            writeln;
  2158.            writeln('Functions can be entered using either');
  2159.            writeln('upper or lowercase letters.');
  2160.          end;
  2161.       5: begin
  2162.            writeln('                 VIEW');
  2163.            writeln;
  2164.            writeln('Azimuth refers to the viewer''s position');
  2165.            writeln('in the x-y plane as follows:');
  2166.            writeln;
  2167.            writeln('    Angle (degrees)     View from');
  2168.            writeln('    ---------------     ---------');
  2169.            writeln('           0             South');
  2170.            writeln('          90             East');
  2171.            writeln('         -90             West');
  2172.            writeln('     -180 or 180         North');
  2173.            writeln;
  2174.            writeln('Elevation refers to the angle above or');
  2175.            writeln('below the x-y plane (directly above the');
  2176.            writeln('origin is 90 degrees and directly below');
  2177.            writeln('is -90).');
  2178.            writeln;
  2179.            writeln('Screen scale refers to the image size');
  2180.            writeln('and ranges from 50 to 200 percent of the');
  2181.            writeln('default size.')
  2182.          end;
  2183.       6: begin
  2184.            writeln('         VIEW (continued)');
  2185.            writeln;
  2186.            writeln('FAST plotting is approximately twice as');
  2187.            writeln('fast as SLOW.  However, it assumes that');
  2188.            writeln('if both endpoints of a line segment are');
  2189.            writeln('visible then the entire segment will be');
  2190.            writeln('too.  This is not always true.  SLOW');
  2191.            writeln('plotting doesn''t make this assumption');
  2192.            writeln('and will be more accurate in certain');
  2193.            writeln('(rather rare) circumstances.');
  2194.            writeln;
  2195.            writeln('The remaining options are turned on or');
  2196.            writeln('off by clicking on the corresponding');
  2197.            writeln('text.')
  2198.          end;
  2199.       7: begin
  2200.            writeln('                 DRAW');
  2201.            writeln;
  2202.            writeln('Draws the graph on the screen.');
  2203.            writeln;
  2204.            writeln('The program automatically keeps track');
  2205.            writeln('of whether it needs to calculate a new');
  2206.            writeln('set of coordinates.  This is necessary');
  2207.            writeln('anytime you change a value in the GRID');
  2208.            writeln('option or enter a new function.');
  2209.            writeln;
  2210.            writeln('The program also keeps track of the');
  2211.            writeln('need to transform the coordinates');
  2212.            writeln('because of a change in azimuth,');
  2213.            writeln('elevation, or screen scale.');
  2214.            writeln;
  2215.            writeln('These operations will be performed as');
  2216.            writeln('necessary before the graph is drawn.')
  2217.          end
  2218.     end;
  2219.  
  2220.     { Set up buttons at bottom of help screen }
  2221.  
  2222.     if Help_Screen <> 1 then begin
  2223.       GotoXY(24,3); write('BACK');
  2224.       Frame_Rect(0,180*r,64,16*r)
  2225.     end;
  2226.     GotoXY(24,19); write('MENU');
  2227.     Frame_Rect(128,180*r,64,16*r);
  2228.     if Help_Screen <> 7 then begin
  2229.       GotoXY(24,35); write('NEXT');
  2230.       Frame_Rect(256,180*r,64,16*r)
  2231.     end;
  2232.  
  2233.     { Wait until user clicks on a button and take appropriate action. }
  2234.  
  2235.     Done := FALSE;
  2236.     repeat
  2237.       Set_Mouse(M_Arrow);
  2238.       Show_Mouse;
  2239.       Event := Get_Event(E_Button,1,1,1,0,FALSE,0,0,0,0,FALSE,0,0,0,0,
  2240.                        Dummy_Buffer,Dummy,Dummy,Dummy,mx,my,Dummy);
  2241.       Hide_Mouse;
  2242.       if Res = Hi then
  2243.         my := my DIV 2;
  2244.       if Event = E_Button then
  2245.         if (my>180) AND (my<200) then begin
  2246.           if (mx>0) AND (mx<63) AND (Help_Screen<>1) then begin
  2247.             Help_Screen := Help_Screen - 1;
  2248.             Done := TRUE
  2249.           end
  2250.           else if (mx>128) AND (mx<191) then begin
  2251.             Quit := TRUE;
  2252.             Done := TRUE
  2253.           end
  2254.           else if (mx>256) AND (mx<319) AND (Help_Screen<>7) then begin
  2255.             Help_Screen := Help_Screen + 1;
  2256.             Done := TRUE
  2257.           end
  2258.         end
  2259.     until Done
  2260.   until Quit
  2261. end; {Show_Help}
  2262.  
  2263. {************************************************
  2264.         M A I N   D R I V E R
  2265.  ************************************************}
  2266.  
  2267.  
  2268. begin
  2269.   if INIT_GEM >= 0 then begin
  2270.     Hide_Mouse;
  2271.     Initialization;
  2272.     PostFix := Convert(InFix, Syntax_Error);
  2273.     Option := Menu_Option;
  2274.     while Option <> Quit do begin
  2275.       case Option of
  2276.         Colors: Get_Colors(Intensity);
  2277.         Grid: Get_Grid_Parameters(Grid_Scale, XLim, YLim, Must_Load2);
  2278.         G_Function: Get_Function(InFix, PostFix);
  2279.         View: Get_View(Azimuth,Altitude,Screen_Scale,Plot_Fast,
  2280.                          Perspective, Draw_Both_Ways, Hidden_Lines,
  2281.                          Draw_Top,Draw_Bottom,Must_Transform);
  2282.         Draw: begin
  2283.                 if Must_Load1 or Must_Load2 then
  2284.                   Load_Point_Array;
  2285.                 if Must_Transform then
  2286.                   Transform_Point_Array;
  2287.                 if Hidden_Lines then
  2288.                   Draw_Graph
  2289.                 else
  2290.                   Quick_Draw_Graph
  2291.               end;
  2292.         Help: Show_Help
  2293.       end; {case}
  2294.       Option := Menu_Option
  2295.     end; {while}
  2296.     Set_Mouse(M_Arrow);
  2297.     Show_Mouse;
  2298.     Set_Color(0,1000,1000,1000);
  2299.     Set_Color(1,0,0,0);
  2300.     Set_Color(2,1000,0,0);
  2301.     Exit_Gem
  2302.   end {if}
  2303. end.
  2304.